perm filename SUBTCH[MUS,LCS] blob sn#007354 filedate 1974-01-08 generic text, type T, neo UTF8
C  *******  SUBTCH  ****** CRITICIZES MELODIC LINE.
	SUBROUTINE SUBR
	COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST
	DIMENSION N(50),JINT(50),LINT(14),INT(50),NINT(50),MINT(3)
	DATA LINT/'P1','MN2','MJ2','MN3','MJ3','P4','TRT','P5','MN6',
	1'MJ6','MN7','MJ7','P8','ERR'/,MINT/'UP',' ','DN'/
	IAUG2='A2'
	IDIM7='DM7'
C   ACCEPTS UP TO 50 NOTES.

	J=P(3)
	IF(J.EQ.84)GO TO 1
C  NOTE '84' SIGNALS END OF INPUT, NO WORK DONE UNTIL ALL NTS STORED.
	I=CNT(INUM)
C  'I' WILL BE TOTAL NUMB. OF NOTES.
	N(I)=J
C  'N' ARRAY STORES NOTE NUMBERS.
	RETURN
1	KL=-1
	NERR=0
C   NERR HOLDS NUMB. OF FIRST ERROR
C  WORK STARTS HERE.  KL IS COUNTER FOR PAIRS OF OUTPUT.

	N1=N(1)
	MAJ=.FALSE.
	MIN=MAJ
	DO 66 K=1,I-1
66	INT(K)=N(K+1)-N(K)
	DO 2 K=1,I-1
C   MAIN LOOP
   	KM=K-2
	KQ=K-1
	KK=K+1
	L=N(KK)-N(K)
C   L IS 1/2 STEPS BETWEEN NOTES.
6	KL=KL+2
	LL=IABS(L)+1
CC	INT(K)=L
C   LL IS INTERVAL, INT ARRAY STORES FOR FUTURE.
	M=N(K)
	MX=M-N1
C   MX IS INTERVAL TO 1ST NOTE.
	MZ=N(KK)-N1
C  INT. BETWEEN NEXT NOTE AND OPENING NOTE.
	IF(MX.EQ.9.OR.MX.EQ.-3)GO TO 112
C  JUMP IF PERF.1,4,5,8
	IF(MX.EQ.3.OR.MX.EQ.8.OR.MX.EQ.10.OR.MX.EQ.-2.
	1 OR.MX.EQ.-4.OR.MX.EQ.-9)MIN=.TRUE.
C  FINDS MN3 OR 6 OF SCALE
	IF(MX.NE.1.AND.IABS(MX).NE.6.AND.MX.NE.-11)GO TO 60 
C  FINDS WRONG SCALE NOTES (FLAT 2, #4)
	IF(NERR.EQ.0)NERR=K
	TYPE 35,K
60	IF(MX.EQ.4.OR.MX.EQ.-8)MAJ=.TRUE.
C  FINDS MJ3
	IF(.NOT.MAJ.OR..NOT.MIN)GO TO 112
	TYPE 36,K
	IF(NERR.EQ.0)NERR=K
	MIN=.FALSE.
112	IF(MX.NE.9)GO TO 50
C  JUMP IF NOT MJ6,DIM7
	IF(L.EQ.3)CALL BADINT(IAUG2,KK,NERR)
	IF(L.EQ.-9)CALL BADINT(IDIM7,KK,NERR)
50	IF((MX.EQ.-4.AND.L.EQ.3).OR.((MX.EQ.-1.OR.MX.EQ.11).AND.L.EQ.-3))
	1CALL BADINT(IAUG2,KK,NERR)
	IF(MX.EQ.-1.AND.L.EQ.9)CALL BADINT(IDIM7,KK,NERR)
11	IF(LL.LT.4.OR.LL.EQ.7)GO TO 10
C  WAS GO TO 200!!
	IF(LL.NE.9.AND.LL.NE.13)GO TO 1100
C  NEXT CHECKS DIRECTION OF OCT. OR MN6 JUMP.
	IF(K.EQ.1.OR.K.EQ.I-1)GO TO 1100
	IF(L*INT(K-1).LT.0)GO TO 100
	TYPE 30,LINT(LL),KK
	IF(NERR.EQ.0)NERR=KK
100	IF(L*INT(KK).LT.0)GO TO 1100
	M=KK+1
	TYPE 30,LINT(LL),M
	IF(NERR.EQ.0)NERR=M
1100	IF(K.LT.3)GO TO 10
	IF(N(KM).EQ.N(K).AND.IABS(INT(KQ)).GT.2)TYPE 31,K
C  NON-STEP RETURN TO PITCH. NOT NECESSARILY AN ERROR.
	M=IABS(N(KM)-N(K))
CC	IF(M.EQ.11.OR.M.EQ.10.AND.LL.NE.13)TYPE 32,K
	IF(M.NE.11.AND.M.NE.10.OR.LL.EQ.13)GO TO 10 
C   FINDS 7TH IN 3 NOTES.
	IF(NERR.EQ.0)NERR=K
	TYPE 32,K
10	M=2
	IF(L.GT.0)M=1
	IF(L.LT.0)M=3
	NINT(K)=MINT(M)
C  'M' IS FOR UP-DOWN TYPE OUT, NINT ARRAY STORES IT.
7	IF(LL.GT.1.AND.LL.LT.13)GO TO 4
C   JUMP IF INTERVAL IS PROBABLY LEGAL.
	IF(LL.LT.2)CALL BADINT(LINT(LL),KK,NERR)
	IF(LL.LT.14)GO TO 5   
	TYPE 33,KK
	IF(NERR.EQ.0)NERR=KK
	 GO TO 5
4     IF(LL.EQ.7.OR.(LL.GT.9.AND.LL.NE.13))CALL BADINT(LINT(LL),KK,
	1NERR)
C   CHECKS AUG4, MJ6-MJ7
5	MM=LL
	IF(MM.GT.14)MM=14
 	JINT(KL)=LINT(MM)
C NEXT FINDS ARPEGGIO IN 4 NOTES.
	IF(K.LT.3.OR.LL.LT.4)GO TO 22
	LA=IABS(N(K)-N(KM))
C INT. BETWEEN THIS AND 2ND NOTE BACK.
	LB=IABS(N(KK)-N(KM))
C INT. BETWEEN NEXT NOTE AND 2ND NOTE BACK.
	LC=IABS(N(KK)-N(KQ))
C INT. BETWEEN NEXT AND 1ST NOTE BACK.
2222	IF((LA.LT.3.AND.LA.GT.0).OR.(LB.LT.3.AND.LB.GT.0).OR.(LC.LT
	1 .3.AND.LC.GT.0).OR.LC.EQ.11.OR.LB.EQ.11.OR.LA.EQ.11)GO TO 22
	IF(IABS(INT(KM)).LT.3.OR.IABS(INT(KQ)).LT.3)GO TO 22  
	TYPE 37,KK
	IF(NERR.EQ.0)NERR=KK
22	IF(LL.NE.2.OR.MZ.EQ.2.OR.IABS(MZ).EQ.5.OR.IABS(MZ).EQ.7
	1.OR.MZ.EQ.-10)GO TO 2
C  JUMP IF P4,5 OR 2ND OF SCALE OR NOT 1/2 STEP.
	IF(((MZ.EQ.9.OR.MZ.EQ.11.OR.MZ.EQ.-3.OR.MZ.EQ.-1.OR.MZ.EQ.4)
	1.AND.L.LT.0).OR.(
	1(MZ.EQ.10.OR.MZ.EQ.12.OR.MZ.EQ.-2.OR.MZ.EQ.0).AND.L.GT.0))GO TO 2   
C  FINDS CHROMATICISM
	IF(NERR.EQ.0)NERR=KK
	TYPE 38,KK
2	JINT(KL+1)=MINT(M)
C   STORES INT. NAMES AND UP-DOWN
	M=N(I)
	IF(N1.EQ.M.OR.N1.EQ.M+12.OR.N1.EQ.M-12)GO TO 61
	TYPE 34
	IF(NERR.EQ.0)NERR=I
61	TYPE 3,(JINT(L),L=1,KL+1)
	TYPE 39,NERR
	CALL EXIT
39	FORMAT(I3/)
3	FORMAT(3(6(3X2A4)/))
30	FORMAT(' MUST CHNG DIR WITH ',A4,' - NOTE ',I2)
31	FORMAT(' RETURNS TO SAME NOTE AFTER LEAP - NOTE ',I2)
32	FORMAT(' 7TH IN 3 NOTES - NOTE ',I2)
33	FORMAT(' SKIP TOO LARGE.  NOTE ',I2)
34	FORMAT(' ENDS ON WRONG NOTE.')
35	FORMAT(' NOTE ',I2,' NOT IN SCALE.')
36	FORMAT(' NOTE ',I2,' MAJOR OR MINOR?')
37	FORMAT(' 4-NOTE ARPEGGIO - NOTE ',I2)
38	FORMAT(' CHROMATICISM - NOTE ',I2)
	END
	SUBROUTINE BADINT(I,J,NERR)

	IF(NERR.EQ.0)NERR=J
	TYPE 300,I,J
	RETURN
300	FORMAT(' ILLEGAL INTERVAL, ',A4,'  NOTE ',I2)
	END